home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 32 / pocket.zip / PHONE.BAS < prev   
BASIC Source File  |  1986-12-08  |  9KB  |  235 lines
  1. 1000 ' 
  2. 1010 '  '
  3. 1020 '  TYPE "BASIC PHONE" TO RUN THIS PROGRAM ON AN IBM-PC.
  4. 1030 '  '
  5. 1040 '  PHONE COPYRIGHT (C) 1985, 1986 TURING & BABBAGE.
  6. 1050 '  '
  7. 1060 '  PERMISSION IS GRANTED TO REPRODUCE THIS PROGRAM, CIRCULATE IT WITHOUT
  8. 1070 '  CHARGE, AND USE IT FOR EVALUATION PURPOSES ONLY.  REGULAR USE
  9. 1080 '  REQUIRES ROYALTY PAYMENT OF $20 TO TURING & BABBAGE, P.O. BOX 785,
  10. 1090 '  BROOKLINE, MA 02146 USA.  YOU MAY MODIFY AND CIRCULATE THIS PROGRAM
  11. 1100 '  PROVIDED YOU DO NOT REMOVE OR CHANGE THIS OR ANY OTHER MESSAGE.
  12. 1110 '  PLEASE SEND YOUR NEW CODE, COMMENTS OR SUGGESTIONS TO TURING &
  13. 1120 '  BABBAGE OR TO COMPUSERV USER ID [72007,147].  THANK YOU.
  14. 1130 '  '
  15. 1140 ' 
  16. 1150 'START:
  17. 1160  GOSUB 3110  
  18. 1170  GOSUB 1290  
  19. 1180  GOSUB 1230  
  20. 1190  GOSUB 1530  
  21. 1200  GOSUB 2090  
  22. 1210  GOSUB 2680  
  23. 1220  SYSTEM
  24. 1230 'SETTINGS:
  25. 1240  'CALC SIZE FROM PRINTER SELECTION
  26. 1250  PGX=INT(PGXIN*CHRPERIN)-EDGEMAR-SPINEMAR : PGY=INT(PGYIN*LINPERIN)-YMAR*2-1
  27. 1260  DIM PG$(PGY)
  28. 1270  PGCNT=0
  29. 1280  RETURN 'SETTINGS
  30. 1290 'USER.INPUT:
  31. 1300  PRINT "Turing & Babbage PHONE V2.0 (C) 1985, 1986"
  32. 1310  LINE INPUT "TYPE YOUR PHONE BOOK FILE NAME (ENTER FOR HELP): ";FILEIN$
  33. 1320  IF FILEIN$="" THEN GOSUB 2850  : GOTO 1290   
  34. 1330  GOSUB 1360  
  35. 1340  GOSUB 1410  
  36. 1350  RETURN 'USER.INPUT
  37. 1360 'USER.INPUT.DEVICE:
  38. 1370  PRINT "PRESS ENTER NOW TO SEND OUTPUT TO YOUR PRINTER, OR ENTER A FILENAME: ";
  39. 1380  LINE INPUT PRDEV$
  40. 1390  IF PRDEV$="" THEN PRDEV$="LPT1:"
  41. 1400  RETURN 'USER.INPUT.DEVICE
  42. 1410 'USER.INPUT.PRINTER:
  43. 1420  PRINT "SELECT A PRINTER"
  44. 1430  FOR I=1 TO PRCOUNT
  45. 1440   PRINT USING "####.  ";I; : PRINT PRNAM$(I)
  46. 1450  NEXT
  47. 1460 'USER.INPUT.PRINTER.2:
  48. 1470  LINE INPUT "ENTER PRINTER NUMBER: ";A$ : A=INT(VAL(A$))
  49. 1480  IF A<1 OR A>PRCOUNT THEN GOTO 1460  
  50. 1490  PRNAM$=PRNAM$(A) : PRINIT$=PRINIT$(A) : PGXIN=PGXIN(A) : PGYIN=PGYIN(A)
  51. 1500  CHRPERIN=CHRPERIN(A) : LINPERIN=LINPERIN(A)
  52. 1510  EDGEMAR=EDGEMAR(A) : SPINEMAR=SPINEMAR(A) : YMAR=YMAR(A)
  53. 1520  RETURN 'USER.INPUT.PRINTER
  54. 1530 'PASS.1:
  55. 1540  OPEN FILEIN$ FOR INPUT AS #1
  56. 1550  OPEN "PHONE.TMP" FOR OUTPUT AS #2
  57. 1560  OPEN "PHONE.ERR" FOR OUTPUT AS #3
  58. 1570  GOSUB 1960  
  59. 1580 'S.2000:
  60. 1590  FOR E=1 TO PGY
  61. 1600 'S.2005:
  62. 1610  IF EOF(1) THEN GOTO 1720  
  63. 1620  IF B$="" THEN LINE INPUT #1,A$ ELSE A$=",,"+B$
  64. 1630  B$="" : B=INSTR(A$,",,") : IF B THEN B$=MID$(A$,B+2) : A$=LEFT$(A$,B-1)
  65. 1640  IF LEFT$(A$,2)="@R" THEN A$="" : B$="" : GOTO 1600  
  66. 1650  IF LEFT$(A$,2)="@S" THEN IF VAL(MID$(A$,3))+E-1<=PGY THEN  GOTO 1600  ELSE E=PGY : GOTO 1700   
  67. 1660  IF LEN(A$)>PGX THEN GOSUB 1770  
  68. 1670  IF LEN(B$)>PGX-1 THEN GOSUB 1820  
  69. 1680  B=PGX-LEN(A$)-LEN(B$) 'SPACE REMAINING ON LINE
  70. 1690   IF B>=0 THEN GOSUB 1870  ELSE GOSUB 1900   
  71. 1700 'S.2120:
  72. 1710  NEXT
  73. 1720 'S.3000:
  74. 1730  GOSUB 2000  : GOSUB 1960   
  75. 1740  IF NOT EOF(1) GOTO 1580  
  76. 1750  CLOSE #1 : CLOSE #2 : CLOSE #3
  77. 1760  RETURN 'PASS.1
  78. 1770 'TRUNCATE.A:
  79. 1780  PRINT #3,"Truncated: ";A$
  80. 1790  PRINT "This is too long and was truncated as shown:"
  81. 1800  PRINT " ";A$ : A$=LEFT$(A$,PGX) : PRINT " ";A$
  82. 1810  RETURN
  83. 1820 'TRUNCATE.B:
  84. 1830  PRINT #3,"Truncated: ";B$
  85. 1840  PRINT "This is too long and was truncated as shown:"
  86. 1850  PRINT " ";B$ : B$=LEFT$(B$,PGX-1) : PRINT " ";B$
  87. 1860  RETURN
  88. 1870 'JOIN.LINE:
  89. 1880  PG$(E)=A$+STRING$(B,32)+B$ : B$=""
  90. 1890  RETURN
  91. 1900 'SPLIT.LINE:
  92. 1910  PG$(E)=A$+STRING$(PGX-LEN(A$),32)
  93. 1920  PRINT "This line too long.  It will be split into two lines."
  94. 1930  PRINT " ";A$;",,";B$
  95. 1940  PRINT #3,"Split: ";A$;",,";B$
  96. 1950  RETURN
  97. 1960 'S.5000:
  98. 1970  ' CLR PG$()
  99. 1980  FOR II=1 TO PGY : PG$(II)=STRING$(PGX,32) : NEXT
  100. 1990  RETURN
  101. 2000 'PRINT.PAGE:
  102. 2010  ' PRINT A PAGE
  103. 2020  FOR I=1 TO PGY
  104. 2030  PRINT #2,PG$(I)
  105. 2040  NEXT
  106. 2050  PGCNT=PGCNT+1
  107. 2060  PRINT #2,CHR$(12)
  108. 2070  PRINT "Finished preparing page";PGCNT;CHR$(13);
  109. 2080  RETURN 'PRINT.PAGE
  110. 2090 'PASS.2:
  111. 2100  OPEN "PHONE.TMP" FOR INPUT AS #1
  112. 2110  OPEN PRDEV$ FOR OUTPUT AS #2
  113. 2120  IF PRDEV$="LPT1:" THEN WIDTH #2,255
  114. 2130  PRINT #2,PRINIT$;
  115. 2140  ' INIT PAGE COUNTERS
  116. 2150  TOPDN=1 : BOTUP=PGCNT
  117. 2160  IF (BOTUP/2)<>INT(BOTUP/2) THEN BOTUP=BOTUP+1
  118. 2170  LASTPG=BOTUP/2
  119. 2180 'S.7300:
  120. 2190  ' LOOP TO PRINT SHEETS
  121. 2200  SHEET=.5+(BOTUP-TOPDN)/2
  122. 2210  PRINT "Printing sheet";SHEET;"for pages";TOPDN;"and";BOTUP
  123. 2220  PRINT #2,"This is sheet";SHEET : PRINT #2,""
  124. 2230  OPEN "PHONE.TMP" FOR INPUT AS #3 : I=1
  125. 2240  ' FIND BOTUP PAGE
  126. 2250  WHILE NOT EOF(3) AND I<BOTUP
  127. 2260 'S.7340:
  128. 2270   LINE INPUT #3,A$ : IF A$<>CHR$(12) THEN GOTO 2260  
  129. 2280   I=I+1
  130. 2290  WEND
  131. 2300  ' SEND THE SHEET
  132. 2310  PRINT #2,"     ";"+";
  133. 2320  FOR I=1 TO 1+PGX*2+EDGEMAR*2+SPINEMAR*2 : PRINT #2,"-"; : NEXT
  134. 2330  PRINT #2,"+"
  135. 2340  GOSUB 2620  
  136. 2350  FOR LNCT=1 TO PGY ' FOR EACH LINE IN SHEET
  137. 2360   PRINT #2,"     |";
  138. 2370   FOR I=1 TO EDGEMAR : PRINT #2," "; : NEXT
  139. 2380   A$=STRING$(PGX,32)
  140. 2390   IF NOT EOF(1) THEN LINE INPUT #1,A$
  141. 2400   PRINT #2,A$;
  142. 2410   FOR I=1 TO SPINEMAR : PRINT #2," "; : NEXT
  143. 2420   PRINT #2,"|";
  144. 2430   FOR I=1 TO SPINEMAR : PRINT #2," "; : NEXT
  145. 2440   A$=STRING$(PGX,32)
  146. 2450   IF NOT EOF(3) THEN LINE INPUT #3,A$
  147. 2460   PRINT #2,A$;
  148. 2470   FOR I=1 TO EDGEMAR : PRINT #2," "; : NEXT
  149. 2480   PRINT #2,"|"
  150. 2490  NEXT ' LINE IN SHEET
  151. 2500  LINE INPUT #1,A$ 'EAT ^L LINE
  152. 2510  CLOSE #3 ' END OF SHEET
  153. 2520  GOSUB 2620  
  154. 2530  PRINT #2,"     ";"+";
  155. 2540  FOR I=1 TO 1+PGX*2+EDGEMAR*2+SPINEMAR*2 : PRINT #2,"-"; : NEXT
  156. 2550  PRINT #2,"+";
  157. 2560  PRINT #2, : PRINT #2,CHR$(12);
  158. 2570  BOTUP=BOTUP-1 : TOPDN=TOPDN+1
  159. 2580  ' LOOP TO PRINT NEXT SHEET
  160. 2590  IF TOPDN<=LASTPG GOTO 2180  
  161. 2600  CLOSE #1 : CLOSE #2
  162. 2610  RETURN 'PASS.2
  163. 2620 'YMAR.EMPTY.LINES:
  164. 2630  FOR I=1 TO YMAR
  165. 2640   PRINT #2,"     |";STRING$(EDGEMAR+PGX+SPINEMAR,32);"|";
  166. 2650   PRINT #2,STRING$(SPINEMAR+PGX+EDGEMAR,32);"|"
  167. 2660  NEXT
  168. 2670  RETURN 'YMAR.EMPTY.LINES
  169. 2680 'CUT.INSTRUCTIONS:
  170. 2690  CLS
  171. 2700  PRINT "Your telephone book is ready to staple, fold and cut as below."
  172. 2710  PRINT ""
  173. 2720  PRINT "1) Stack the sheets in order, Face Up, with Sheet 1 on the top."
  174. 2730  PRINT "2) Turn the stack Face Down and staple twice along the center line."
  175. 2740  PRINT "3) Cut the top and bottom edges of the book."
  176. 2750  PRINT "4) Fold and firmly crease the book along the center line."
  177. 2760  PRINT "5) Cut the right edge."
  178. 2770  PRINT ""
  179. 2780  PRINT "If you use this program, please pay for it."
  180. 2790  PRINT "The suggested price is $20, or $25 for a copy of the latest version."
  181. 2800  PRINT "Please pass this program along to a friend."
  182. 2810  PRINT ""
  183. 2820  PRINT "Turing & Babbage, P.O. Box 785, Brookline, Massachusetts 02146 USA"
  184. 2830  PRINT
  185. 2840  RETURN
  186. 2850 'HELP:
  187. 2860  CLS
  188. 2870  PRINT "This Turing & Babbage program, PHONE, prints a pocket-size telephone"
  189. 2880  PRINT "book ready to be stapled and folded.  Prepare an ASCII text file with
  190. 2890  PRINT "the contents of your phone book, then run this program."
  191. 2900  PRINT ""
  192. 2910  PRINT "PHONE will set numbers against the right margin of your phone book"
  193. 2920  PRINT "if you use ,, in your input file."
  194. 2930  PRINT ""
  195. 2940  PRINT "Example Input:                    Printed in your PHONEbook:"
  196. 2950  PRINT "Eisenberg, Joel,,415 555 1212     Eisenberg, Joel     415 555 1212"
  197. 2960  PRINT ",,Work 800 555 1212                              Work 800 555 1212"
  198. 2970  PRINT ",,Nantucket,,617 228 0000                   Nantucket 617 228 0000"
  199. 2980  PRINT ""
  200. 2990  PRINT "PHONE is distributed with these files:"
  201. 3000  PRINT "     PHONE.BAS     Phone program source"
  202. 3010  PRINT "     PHONE.1       An example PHONE file."
  203. 3020  PRINT ""
  204. 3030  PRINT "If you use this program, please pay for it."
  205. 3040  PRINT "Send $20, or $25 for a copy of the latest version."
  206. 3050  PRINT "Please pass this program along to a friend."
  207. 3060  PRINT ""
  208. 3070  PRINT "Turing & Babbage, P.O. Box 785, Brookline, Massachusetts 02146 USA"
  209. 3080  LINE INPUT "Press ENTER to continue.";A$
  210. 3090  CLS
  211. 3100  RETURN 'HELP
  212. 3110 'PRINTER.DATA:
  213. 3120  'PGXIN, PGYIN DESIRED BOOK SIZE IN INCHES
  214. 3130  'CHRPERIN, LINPERIN ARE PRINT SIZE FOR THE PRINTER
  215. 3140  'EDGEMAR MARGIN IN CHARACTERS BETWEEN TEXT  AND EDGE OF BOOK
  216. 3150  'SPINEMAR MARGIN IN CHARACTERS BETWEEN TEXT AND SPINE OF BOOK
  217. 3160  'YMAR TOP/BOTTOM MARGIN IN LINES
  218. 3170  ESC$=CHR$(27)
  219. 3180  I=1
  220. 3190  PRNAM$(I)="IBM or Standard Printer (Compressed Print)"
  221. 3200  PRINIT$(I)=CHR$(128+15)+ESC$+"0"+ESC$+"U"+CHR$(1)+CHR$(128+12)
  222. 3210  PGXIN(I)=3.1 : PGYIN(I)=5.75 : CHRPERIN(I)=16.666 : LINPERIN(I)=8
  223. 3220  EDGEMAR(I)=5 : SPINEMAR(I)=4 : YMAR(I)=1
  224. 3230  I=2
  225. 3240  PRNAM$(I)="HP LaserJet (Compressed Print)"
  226. 3250  PRINIT$(I)=ESC$+"E"+ESC$+"&l1O"+ESC$+"(8U"+ESC$+"(s0p16.66h8.5v0s-1b0T"+ESC$+"&l5.6666C"
  227. 3260  PGXIN(I)=3.1 : PGYIN(I)=5.75 : CHRPERIN(I)=16.666 : LINPERIN(I)=8.5
  228. 3270  EDGEMAR(I)=5 : SPINEMAR(I)=4 : YMAR(I)=1
  229. 3280  I=3
  230. 3290  PRNAM$(I)="Standard Printer (Large Print)" : PRINIT$(I)=CHR$(12)
  231. 3300  PGXIN(I)=3.5 : PGYIN(I)=5.75 : CHRPERIN(I)=10 : LINPERIN(I)=6
  232. 3310  EDGEMAR(I)=1 : SPINEMAR(I)=1 : YMAR(I)=0
  233. 3320  PRCOUNT=3 : RETURN 'PRINTER.DATA
  234. 3330 '
  235.